home *** CD-ROM | disk | FTP | other *** search
/ Netscape Plug-Ins Developer's Kit / Netscape_Plug-Ins_Developers_Kit.iso / CGIPERL / MACPERL / MSRCE418.HQX / Perl Source ƒ / Perl / consarg.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-08-01  |  30.7 KB  |  1,379 lines
  1. /* $RCSfile: consarg.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 12:26:27 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log:    consarg.c,v $
  9.  * Revision 4.0.1.4  92/06/08  12:26:27  lwall
  10.  * patch20: new warning for use of x with non-numeric right operand
  11.  * patch20: modulus with highest bit in left operand set didn't always work
  12.  * patch20: illegal lvalue message could be followed by core dump
  13.  * patch20: deleted some minor memory leaks
  14.  * 
  15.  * Revision 4.0.1.3  91/11/05  16:21:16  lwall
  16.  * patch11: random cleanup
  17.  * patch11: added eval {}
  18.  * patch11: added sort {} LIST
  19.  * patch11: "foo" x -1 dumped core
  20.  * patch11: substr() and vec() weren't allowed in an lvalue list
  21.  * 
  22.  * Revision 4.0.1.2  91/06/07  10:33:12  lwall
  23.  * patch4: new copyright notice
  24.  * patch4: length($`), length($&), length($') now optimized to avoid string copy
  25.  * 
  26.  * Revision 4.0.1.1  91/04/11  17:38:34  lwall
  27.  * patch1: fixed "Bad free" error
  28.  * 
  29.  * Revision 4.0  91/03/20  01:06:15  lwall
  30.  * 4.0 baseline.
  31.  * 
  32.  */
  33.  
  34. #include "EXTERN.h"
  35. #include "perl.h"
  36. static int nothing_in_common();
  37. static int arg_common();
  38. static int spat_common();
  39.  
  40. ARG *
  41. make_split(stab,arg,limarg)
  42. register STAB *stab;
  43. register ARG *arg;
  44. ARG *limarg;
  45. {
  46.     register SPAT *spat;
  47.  
  48.     if (arg->arg_type != O_MATCH) {
  49.     Newz(201,spat,1,SPAT);
  50.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  51.     curstash->tbl_spatroot = spat;
  52.  
  53.     spat->spat_runtime = arg;
  54.     arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
  55.     }
  56.     Renew(arg,4,ARG);
  57.     arg->arg_len = 3;
  58.     if (limarg) {
  59.     if (limarg->arg_type == O_ITEM) {
  60.         Copy(limarg+1,arg+3,1,ARG);
  61.         limarg[1].arg_type = A_NULL;
  62.         arg_free(limarg);
  63.     }
  64.     else {
  65.         arg[3].arg_flags = 0;
  66.         arg[3].arg_len = 0;
  67.         arg[3].arg_type = A_EXPR;
  68.         arg[3].arg_ptr.arg_arg = limarg;
  69.     }
  70.     }
  71.     else {
  72.     arg[3].arg_flags = 0;
  73.     arg[3].arg_len = 0;
  74.     arg[3].arg_type = A_NULL;
  75.     arg[3].arg_ptr.arg_arg = Nullarg;
  76.     }
  77.     arg->arg_type = O_SPLIT;
  78.     spat = arg[2].arg_ptr.arg_spat;
  79.     spat->spat_repl = stab2arg(A_STAB,aadd(stab));
  80.     if (spat->spat_short) {    /* exact match can bypass regexec() */
  81.     if (!((spat->spat_flags & SPAT_SCANFIRST) &&
  82.         (spat->spat_flags & SPAT_ALL) )) {
  83.         str_free(spat->spat_short);
  84.         spat->spat_short = Nullstr;
  85.     }
  86.     }
  87.     return arg;
  88. }
  89.  
  90. ARG *
  91. mod_match(type,left,pat)
  92. register ARG *left;
  93. register ARG *pat;
  94. {
  95.  
  96.     register SPAT *spat;
  97.     register ARG *newarg;
  98.  
  99.     if (!pat)
  100.     return Nullarg;
  101.  
  102.     if ((pat->arg_type == O_MATCH ||
  103.      pat->arg_type == O_SUBST ||
  104.      pat->arg_type == O_TRANS ||
  105.      pat->arg_type == O_SPLIT
  106.     ) &&
  107.     pat[1].arg_ptr.arg_stab == defstab ) {
  108.     switch (pat->arg_type) {
  109.     case O_MATCH:
  110.         newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH,
  111.         pat->arg_len,
  112.         left,Nullarg,Nullarg);
  113.         break;
  114.     case O_SUBST:
  115.         newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST,
  116.         pat->arg_len,
  117.         left,Nullarg,Nullarg));
  118.         break;
  119.     case O_TRANS:
  120.         newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS,
  121.         pat->arg_len,
  122.         left,Nullarg,Nullarg));
  123.         break;
  124.     case O_SPLIT:
  125.         newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT,
  126.         pat->arg_len,
  127.         left,Nullarg,Nullarg);
  128.         break;
  129.     }
  130.     if (pat->arg_len >= 2) {
  131.         newarg[2].arg_type = pat[2].arg_type;
  132.         newarg[2].arg_ptr = pat[2].arg_ptr;
  133.         newarg[2].arg_len = pat[2].arg_len;
  134.         newarg[2].arg_flags = pat[2].arg_flags;
  135.         if (pat->arg_len >= 3) {
  136.         newarg[3].arg_type = pat[3].arg_type;
  137.         newarg[3].arg_ptr = pat[3].arg_ptr;
  138.         newarg[3].arg_len = pat[3].arg_len;
  139.         newarg[3].arg_flags = pat[3].arg_flags;
  140.         }
  141.     }
  142.     free_arg(pat);
  143.     }
  144.     else {
  145.     Newz(202,spat,1,SPAT);
  146.     spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
  147.     curstash->tbl_spatroot = spat;
  148.  
  149.     spat->spat_runtime = pat;
  150.     newarg = make_op(type,2,left,Nullarg,Nullarg);
  151.     newarg[2].arg_type = A_SPAT | A_DONT;
  152.     newarg[2].arg_ptr.arg_spat = spat;
  153.     }
  154.  
  155.     return newarg;
  156. }
  157.  
  158. ARG *
  159. make_op(type,newlen,arg1,arg2,arg3)
  160. int type;
  161. int newlen;
  162. ARG *arg1;
  163. ARG *arg2;
  164. ARG *arg3;
  165. {
  166.     register ARG *arg;
  167.     register ARG *chld;
  168.     register unsigned doarg;
  169.     register int i;
  170.     extern ARG *arg4;    /* should be normal arguments, really */
  171.     extern ARG *arg5;
  172. #ifdef macintosh
  173.     extern ARG *arg6;
  174. #endif
  175.  
  176.     arg = op_new(newlen);
  177.     arg->arg_type = type;
  178.     /*SUPPRESS 560*/
  179.     if (chld = arg1) {
  180.     if (chld->arg_type == O_ITEM &&
  181.         (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
  182.          (i == A_LEXPR &&
  183.           (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
  184.            chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
  185.            chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
  186.     {
  187.         arg[1].arg_type = chld[1].arg_type;
  188.         arg[1].arg_ptr = chld[1].arg_ptr;
  189.         arg[1].arg_flags |= chld[1].arg_flags;
  190.         arg[1].arg_len = chld[1].arg_len;
  191.         free_arg(chld);
  192.     }
  193.     else {
  194.         arg[1].arg_type = A_EXPR;
  195.         arg[1].arg_ptr.arg_arg = chld;
  196.     }
  197.     }
  198.     /*SUPPRESS 560*/
  199.     if (chld = arg2) {
  200.     if (chld->arg_type == O_ITEM && 
  201.         (hoistable[chld[1].arg_type&A_MASK] || 
  202.          (type == O_ASSIGN && 
  203.           ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
  204.         ||
  205.            (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT))
  206.         ||
  207.            (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT))
  208.           ) ) ) ) {
  209.         arg[2].arg_type = chld[1].arg_type;
  210.         arg[2].arg_ptr = chld[1].arg_ptr;
  211.         arg[2].arg_len = chld[1].arg_len;
  212.         free_arg(chld);
  213.     }
  214.     else {
  215.         arg[2].arg_type = A_EXPR;
  216.         arg[2].arg_ptr.arg_arg = chld;
  217.     }
  218.     }
  219.     /*SUPPRESS 560*/
  220.     if (chld = arg3) {
  221.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  222.         arg[3].arg_type = chld[1].arg_type;
  223.         arg[3].arg_ptr = chld[1].arg_ptr;
  224.         arg[3].arg_len = chld[1].arg_len;
  225.         free_arg(chld);
  226.     }
  227.     else {
  228.         arg[3].arg_type = A_EXPR;
  229.         arg[3].arg_ptr.arg_arg = chld;
  230.     }
  231.     }
  232.     if (newlen >= 4 && (chld = arg4)) {
  233.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  234.         arg[4].arg_type = chld[1].arg_type;
  235.         arg[4].arg_ptr = chld[1].arg_ptr;
  236.         arg[4].arg_len = chld[1].arg_len;
  237.         free_arg(chld);
  238.     }
  239.     else {
  240.         arg[4].arg_type = A_EXPR;
  241.         arg[4].arg_ptr.arg_arg = chld;
  242.     }
  243.     }
  244.     if (newlen >= 5 && (chld = arg5)) {
  245.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  246.         arg[5].arg_type = chld[1].arg_type;
  247.         arg[5].arg_ptr = chld[1].arg_ptr;
  248.         arg[5].arg_len = chld[1].arg_len;
  249.         free_arg(chld);
  250.     }
  251.     else {
  252.         arg[5].arg_type = A_EXPR;
  253.         arg[5].arg_ptr.arg_arg = chld;
  254.     }
  255.     }
  256. #ifdef macintosh
  257.     if (newlen >= 6 && (chld = arg6)) {
  258.     if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
  259.         arg[6].arg_type = chld[1].arg_type;
  260.         arg[6].arg_ptr = chld[1].arg_ptr;
  261.         arg[6].arg_len = chld[1].arg_len;
  262.         free_arg(chld);
  263.     }
  264.     else {
  265.         arg[6].arg_type = A_EXPR;
  266.         arg[6].arg_ptr.arg_arg = chld;
  267.     }
  268.     }
  269. #endif
  270.     doarg = opargs[type];
  271.     for (i = 1; i <= newlen; ++i) {
  272.     if (!(doarg & 1))
  273.         arg[i].arg_type |= A_DONT;
  274.     if (doarg & 2)
  275.         arg[i].arg_flags |= AF_ARYOK;
  276.     doarg >>= 2;
  277.     }
  278. #ifdef DEBUGGING
  279. #ifdef macintosh
  280.     if (debug & 16) {
  281.     fprintf(perldbg,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
  282.     if (arg1)
  283.         fprintf(perldbg,",%s=%lx",
  284.         argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
  285.     if (arg2)
  286.         fprintf(perldbg,",%s=%lx",
  287.         argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
  288.     if (arg3)
  289.         fprintf(perldbg,",%s=%lx",
  290.         argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
  291.     if (newlen >= 4)
  292.         fprintf(perldbg,",%s=%lx",
  293.         argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
  294.     if (newlen >= 5)
  295.         fprintf(perldbg,",%s=%lx",
  296.         argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
  297.     if (newlen >= 6)
  298.         fprintf(perldbg,",%s=%lx",
  299.         argname[arg[6].arg_type&A_MASK],arg[6].arg_ptr.arg_arg);
  300.     fprintf(perldbg,")\n");
  301. #else
  302.     if (debug & 16) {
  303.     fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
  304.     if (arg1)
  305.         fprintf(stderr,",%s=%lx",
  306.         argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg);
  307.     if (arg2)
  308.         fprintf(stderr,",%s=%lx",
  309.         argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg);
  310.     if (arg3)
  311.         fprintf(stderr,",%s=%lx",
  312.         argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg);
  313.     if (newlen >= 4)
  314.         fprintf(stderr,",%s=%lx",
  315.         argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg);
  316.     if (newlen >= 5)
  317.         fprintf(stderr,",%s=%lx",
  318.         argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg);
  319.     fprintf(stderr,")\n");
  320. #endif
  321.     }
  322. #endif
  323.     arg = evalstatic(arg);    /* see if we can consolidate anything */
  324.     return arg;
  325. }
  326.  
  327. #ifdef macintosh
  328. #include <Math.h>
  329.    
  330. static STR * str = Nullstr;
  331. #endif
  332.  
  333. ARG *
  334. evalstatic(arg)
  335. register ARG *arg;
  336. {
  337.     register STR *s1;
  338.     register STR *s2;
  339.     double value;        /* must not be register */
  340.     register char *tmps;
  341.     int i;
  342.     unsigned long tmplong;
  343.     long tmp2;
  344.     char *crypt();
  345. #ifndef macintosh
  346.     double exp(), log(), sqrt(), modf();
  347.     double sin(), cos(), atan2(), pow();
  348.     static STR * str = Nullstr;
  349. #endif
  350.     
  351.     if (!arg || !arg->arg_len)
  352.     return arg;
  353.  
  354.     if (!str)
  355.     str = Str_new(20,0);
  356.  
  357.     if (arg[1].arg_type == A_SINGLE)
  358.     s1 = arg[1].arg_ptr.arg_str;
  359.     else
  360.     s1 = Nullstr;
  361.     if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE)
  362.     s2 = arg[2].arg_ptr.arg_str;
  363.     else
  364.     s2 = Nullstr;
  365.  
  366. #define CHECK1 if (!s1) return arg
  367. #define CHECK2 if (!s2) return arg
  368. #define CHECK12 if (!s1 || !s2) return arg
  369.  
  370.     switch (arg->arg_type) {
  371.     default:
  372.     return arg;
  373.     case O_SORT:
  374.     if (arg[1].arg_type == A_CMD)
  375.         arg[1].arg_type |= A_DONT;
  376.     return arg;
  377.     case O_EVAL:
  378.     if (arg[1].arg_type == A_CMD) {
  379.         arg->arg_type = O_TRY;
  380.         arg[1].arg_type |= A_DONT;
  381.         return arg;
  382.     }
  383.     CHECK1;
  384.     arg->arg_type = O_EVALONCE;
  385.     return arg;
  386.     case O_AELEM:
  387.     CHECK2;
  388.     i = (int)str_gnum(s2);
  389.     if (i < 32767 && i >= 0) {
  390.         arg->arg_type = O_ITEM;
  391.         arg->arg_len = 1;
  392.         arg[1].arg_type = A_ARYSTAB;    /* $abc[123] is hoistable now */
  393.         arg[1].arg_len = i;
  394.         str_free(s2);
  395.         Renew(arg, 2, ARG);
  396.     }
  397.     return arg;
  398.     case O_CONCAT:
  399.     CHECK12;
  400.     str_sset(str,s1);
  401.     str_scat(str,s2);
  402.     break;
  403.     case O_REPEAT:
  404.     CHECK2;
  405.     if (dowarn && !s2->str_nok && !looks_like_number(s2))
  406.         warn("Right operand of x is not numeric");
  407.     CHECK1;
  408.     i = (int)str_gnum(s2);
  409.     tmps = str_get(s1);
  410.     str_nset(str,"",0);
  411.     if (i > 0) {
  412.         STR_GROW(str, i * s1->str_cur + 1);
  413.         repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
  414.         str->str_cur = i * s1->str_cur;
  415.         str->str_ptr[str->str_cur] = '\0';
  416.     }
  417.     break;
  418.     case O_MULTIPLY:
  419.     CHECK12;
  420.     value = str_gnum(s1);
  421.     str_numset(str,value * str_gnum(s2));
  422.     break;
  423.     case O_DIVIDE:
  424.     CHECK12;
  425.     value = str_gnum(s2);
  426.     if (value == 0.0)
  427.         yyerror("Illegal division by constant zero");
  428.     else
  429. #ifdef SLOPPYDIVIDE
  430.     /* insure that 20./5. == 4. */
  431.     {
  432.         double x;
  433.         int    k;
  434.         x =  str_gnum(s1);
  435.         if ((double)(int)x     == x &&
  436.         (double)(int)value == value &&
  437.         (k = (int)x/(int)value)*(int)value == (int)x) {
  438.         value = k;
  439.         } else {
  440.         value = x/value;
  441.         }
  442.         str_numset(str,value);
  443.     }
  444. #else
  445.     str_numset(str,str_gnum(s1) / value);
  446. #endif
  447.     break;
  448.     case O_MODULO:
  449.     CHECK12;
  450.     tmplong = (unsigned long)str_gnum(s2);
  451.     if (tmplong == 0L) {
  452.         yyerror("Illegal modulus of constant zero");
  453.         return arg;
  454.     }
  455.     value = str_gnum(s1);
  456. #ifndef lint
  457.     if (value >= 0.0)
  458.         str_numset(str,(double)(((unsigned long)value) % tmplong));
  459.     else {
  460.         tmp2 = (long)value;
  461.         str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
  462.     }
  463. #else
  464.     tmp2 = tmp2;
  465. #endif
  466.     break;
  467.     case O_ADD:
  468.     CHECK12;
  469.     value = str_gnum(s1);
  470.     str_numset(str,value + str_gnum(s2));
  471.     break;
  472.     case O_SUBTRACT:
  473.     CHECK12;
  474.     value = str_gnum(s1);
  475.     str_numset(str,value - str_gnum(s2));
  476.     break;
  477.     case O_LEFT_SHIFT:
  478.     CHECK12;
  479.     value = str_gnum(s1);
  480.     i = (int)str_gnum(s2);
  481. #ifndef lint
  482.     str_numset(str,(double)(((long)value) << i));
  483. #endif
  484.     break;
  485.     case O_RIGHT_SHIFT:
  486.     CHECK12;
  487.     value = str_gnum(s1);
  488.     i = (int)str_gnum(s2);
  489. #ifndef lint
  490.     str_numset(str,(double)(((long)value) >> i));
  491. #endif
  492.     break;
  493.     case O_LT:
  494.     CHECK12;
  495.     value = str_gnum(s1);
  496.     str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
  497.     break;
  498.     case O_GT:
  499.     CHECK12;
  500.     value = str_gnum(s1);
  501.     str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
  502.     break;
  503.     case O_LE:
  504.     CHECK12;
  505.     value = str_gnum(s1);
  506.     str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
  507.     break;
  508.     case O_GE:
  509.     CHECK12;
  510.     value = str_gnum(s1);
  511.     str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
  512.     break;
  513.     case O_EQ:
  514.     CHECK12;
  515.     if (dowarn) {
  516.         if ((!s1->str_nok && !looks_like_number(s1)) ||
  517.         (!s2->str_nok && !looks_like_number(s2)) )
  518.         warn("Possible use of == on string value");
  519.     }
  520.     value = str_gnum(s1);
  521.     str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
  522.     break;
  523.     case O_NE:
  524.     CHECK12;
  525.     value = str_gnum(s1);
  526.     str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
  527.     break;
  528.     case O_NCMP:
  529.     CHECK12;
  530.     value = str_gnum(s1);
  531.     value -= str_gnum(s2);
  532.     if (value > 0.0)
  533.         value = 1.0;
  534.     else if (value < 0.0)
  535.         value = -1.0;
  536.     str_numset(str,value);
  537.     break;
  538.     case O_BIT_AND:
  539.     CHECK12;
  540.     value = str_gnum(s1);
  541. #ifndef lint
  542.     str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
  543. #endif
  544.     break;
  545.     case O_XOR:
  546.     CHECK12;
  547.     value = str_gnum(s1);
  548. #ifndef lint
  549.     str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
  550. #endif
  551.     break;
  552.     case O_BIT_OR:
  553.     CHECK12;
  554.     value = str_gnum(s1);
  555. #ifndef lint
  556.     str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
  557. #endif
  558.     break;
  559.     case O_AND:
  560.     CHECK12;
  561.     if (str_true(s1))
  562.         str_sset(str,s2);
  563.     else
  564.         str_sset(str,s1);
  565.     break;
  566.     case O_OR:
  567.     CHECK12;
  568.     if (str_true(s1))
  569.         str_sset(str,s1);
  570.     else
  571.         str_sset(str,s2);
  572.     break;
  573.     case O_COND_EXPR:
  574.     CHECK12;
  575.     if ((arg[3].arg_type & A_MASK) != A_SINGLE)
  576.         return arg;
  577.     if (str_true(s1))
  578.         str_sset(str,s2);
  579.     else
  580.         str_sset(str,arg[3].arg_ptr.arg_str);
  581.     str_free(arg[3].arg_ptr.arg_str);
  582.     Renew(arg, 3, ARG);
  583.     break;
  584.     case O_NEGATE:
  585.     CHECK1;
  586.     str_numset(str,(double)(-str_gnum(s1)));
  587.     break;
  588.     case O_NOT:
  589.     CHECK1;
  590. #ifdef NOTNOT
  591.     { char xxx = str_true(s1); str_numset(str,(double)!xxx); }
  592. #else
  593.     str_numset(str,(double)(!str_true(s1)));
  594. #endif
  595.     break;
  596.     case O_COMPLEMENT:
  597.     CHECK1;
  598. #ifndef lint
  599.     str_numset(str,(double)(~U_L(str_gnum(s1))));
  600. #endif
  601.     break;
  602.     case O_SIN:
  603.     CHECK1;
  604.     str_numset(str,sin(str_gnum(s1)));
  605.     break;
  606.     case O_COS:
  607.     CHECK1;
  608.     str_numset(str,cos(str_gnum(s1)));
  609.     break;
  610.     case O_ATAN2:
  611.     CHECK12;
  612.     value = str_gnum(s1);
  613.     str_numset(str,atan2(value, str_gnum(s2)));
  614.     break;
  615.     case O_POW:
  616.     CHECK12;
  617.     value = str_gnum(s1);
  618.     str_numset(str,pow(value, str_gnum(s2)));
  619.     break;
  620.     case O_LENGTH:
  621.     if (arg[1].arg_type == A_STAB) {
  622.         arg->arg_type = O_ITEM;
  623.         arg[1].arg_type = A_LENSTAB;
  624.         return arg;
  625.     }
  626.     CHECK1;
  627.     str_numset(str, (double)str_len(s1));
  628.     break;
  629.     case O_SLT:
  630.     CHECK12;
  631.     str_numset(str,(double)(str_cmp(s1,s2) < 0));
  632.     break;
  633.     case O_SGT:
  634.     CHECK12;
  635.     str_numset(str,(double)(str_cmp(s1,s2) > 0));
  636.     break;
  637.     case O_SLE:
  638.     CHECK12;
  639.     str_numset(str,(double)(str_cmp(s1,s2) <= 0));
  640.     break;
  641.     case O_SGE:
  642.     CHECK12;
  643.     str_numset(str,(double)(str_cmp(s1,s2) >= 0));
  644.     break;
  645.     case O_SEQ:
  646.     CHECK12;
  647.     str_numset(str,(double)(str_eq(s1,s2)));
  648.     break;
  649.     case O_SNE:
  650.     CHECK12;
  651.     str_numset(str,(double)(!str_eq(s1,s2)));
  652.     break;
  653.     case O_SCMP:
  654.     CHECK12;
  655.     str_numset(str,(double)(str_cmp(s1,s2)));
  656.     break;
  657.     case O_CRYPT:
  658.     CHECK12;
  659. #ifdef HAS_CRYPT
  660.         tmps = str_get(s1);
  661.         str_set(str,crypt(tmps,str_get(s2)));
  662. #else
  663.         yyerror(
  664.         "The crypt() function is unimplemented due to excessive paranoia.");
  665. #endif
  666.         break;
  667.     case O_EXP:
  668.     CHECK1;
  669.         str_numset(str,exp(str_gnum(s1)));
  670.         break;
  671.     case O_LOG:
  672.     CHECK1;
  673.         str_numset(str,log(str_gnum(s1)));
  674.         break;
  675.     case O_SQRT:
  676.     CHECK1;
  677.         str_numset(str,sqrt(str_gnum(s1)));
  678.         break;
  679.     case O_INT:
  680.     CHECK1;
  681.         value = str_gnum(s1);
  682. #if defined(macintosh) && !defined(powerc) && !defined(__powerc)
  683.         {
  684.              extended eres;
  685.         if (value >= 0.0)
  686.             (void)modf(value,&eres);
  687.         else {
  688.             (void)modf(-value,&eres);
  689.             eres = -eres;
  690.         }
  691.             str_numset(str,eres);
  692.         }        
  693. #else
  694.         if (value >= 0.0)
  695.         (void)modf(value,&value);
  696.         else {
  697.         (void)modf(-value,&value);
  698.         value = -value;
  699.         }
  700.         str_numset(str,value);
  701. #endif        
  702.         break;
  703.     case O_ORD:
  704.     CHECK1;
  705. #ifndef I286
  706.         str_numset(str,(double)(*str_get(s1)));
  707. #else
  708.         {
  709.         int  zapc;
  710.         char *zaps;
  711.  
  712.         zaps = str_get(s1);
  713.         zapc = (int) *zaps;
  714.         str_numset(str,(double)(zapc));
  715.         }
  716. #endif
  717.         break;
  718.     }
  719.     arg->arg_type = O_ITEM;    /* note arg1 type is already SINGLE */
  720.     str_free(s1);
  721.     arg[1].arg_ptr.arg_str = str;
  722.     if (s2) {
  723.     str_free(s2);
  724.     arg[2].arg_ptr.arg_str = Nullstr;
  725.     arg[2].arg_type = A_NULL;
  726.     }
  727.     str = Nullstr;
  728.  
  729.     return arg;
  730. }
  731.  
  732. ARG *
  733. l(arg)
  734. register ARG *arg;
  735. {
  736.     register int i;
  737.     register ARG *arg1;
  738.     register ARG *arg2;
  739.     SPAT *spat;
  740.     int arghog = 0;
  741.  
  742.     i = arg[1].arg_type & A_MASK;
  743.  
  744.     arg->arg_flags |= AF_COMMON;    /* assume something in common */
  745.                     /* which forces us to copy things */
  746.  
  747.     if (i == A_ARYLEN) {
  748.     arg[1].arg_type = A_LARYLEN;
  749.     return arg;
  750.     }
  751.     if (i == A_ARYSTAB) {
  752.     arg[1].arg_type = A_LARYSTAB;
  753.     return arg;
  754.     }
  755.  
  756.     /* see if it's an array reference */
  757.  
  758.     if (i == A_EXPR || i == A_LEXPR) {
  759.     arg1 = arg[1].arg_ptr.arg_arg;
  760.  
  761.     if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) {
  762.                         /* assign to list */
  763.         if (arg->arg_len > 1) {
  764.         dehoist(arg,2);
  765.         arg2 = arg[2].arg_ptr.arg_arg;
  766.         if (nothing_in_common(arg1,arg2))
  767.             arg->arg_flags &= ~AF_COMMON;
  768.         if (arg->arg_type == O_ASSIGN) {
  769.             if (arg1->arg_flags & AF_LOCAL)
  770.             arg->arg_flags |= AF_LOCAL;
  771.             arg[1].arg_flags |= AF_ARYOK;
  772.             arg[2].arg_flags |= AF_ARYOK;
  773.         }
  774.         }
  775.         else if (arg->arg_type != O_CHOP)
  776.         arg->arg_type = O_ASSIGN;    /* possible local(); */
  777.         for (i = arg1->arg_len; i >= 1; i--) {
  778.         switch (arg1[i].arg_type) {
  779.         case A_STAR: case A_LSTAR:
  780.             arg1[i].arg_type = A_LSTAR;
  781.             break;
  782.         case A_STAB: case A_LVAL:
  783.             arg1[i].arg_type = A_LVAL;
  784.             break;
  785.         case A_ARYLEN: case A_LARYLEN:
  786.             arg1[i].arg_type = A_LARYLEN;
  787.             break;
  788.         case A_ARYSTAB: case A_LARYSTAB:
  789.             arg1[i].arg_type = A_LARYSTAB;
  790.             break;
  791.         case A_EXPR: case A_LEXPR:
  792.             arg1[i].arg_type = A_LEXPR;
  793.             switch(arg1[i].arg_ptr.arg_arg->arg_type) {
  794.             case O_ARRAY: case O_LARRAY:
  795.             arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY;
  796.             arghog = 1;
  797.             break;
  798.             case O_AELEM: case O_LAELEM:
  799.             arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM;
  800.             break;
  801.             case O_HASH: case O_LHASH:
  802.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH;
  803.             arghog = 1;
  804.             break;
  805.             case O_HELEM: case O_LHELEM:
  806.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM;
  807.             break;
  808.             case O_ASLICE: case O_LASLICE:
  809.             arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE;
  810.             break;
  811.             case O_HSLICE: case O_LHSLICE:
  812.             arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
  813.             break;
  814.             case O_SUBSTR: case O_VEC:
  815.             (void)l(arg1[i].arg_ptr.arg_arg);
  816.             Renewc(arg1[i].arg_ptr.arg_arg->arg_ptr.arg_str, 1,
  817.               struct lstring, STR);
  818.                 /* grow string struct to hold an lstring struct */
  819.             break;
  820.             default:
  821.             goto ill_item;
  822.             }
  823.             break;
  824.         default:
  825.           ill_item:
  826.             (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",
  827.               argname[arg1[i].arg_type&A_MASK]);
  828.             yyerror(tokenbuf);
  829.         }
  830.         }
  831.         if (arg->arg_len > 1) {
  832.         if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) {
  833.             arg2[3].arg_type = A_SINGLE;
  834.             arg2[3].arg_ptr.arg_str =
  835.               str_nmake((double)arg1->arg_len + 1); /* limit split len*/
  836.         }
  837.         }
  838.     }
  839.     else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
  840.         if (arg->arg_type == O_DEFINED)
  841.         arg1->arg_type = O_AELEM;
  842.         else
  843.         arg1->arg_type = O_LAELEM;
  844.     else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
  845.         arg1->arg_type = O_LARRAY;
  846.         if (arg->arg_len > 1) {
  847.         dehoist(arg,2);
  848.         arg2 = arg[2].arg_ptr.arg_arg;
  849.         if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/
  850.             spat = arg2[2].arg_ptr.arg_spat;
  851.             if (!(spat->spat_flags & SPAT_ONCE) &&
  852.               nothing_in_common(arg1,spat->spat_repl)) {
  853.             spat->spat_repl[1].arg_ptr.arg_stab =
  854.                 arg1[1].arg_ptr.arg_stab;
  855.             arg1[1].arg_ptr.arg_stab = Nullstab;
  856.             spat->spat_flags |= SPAT_ONCE;
  857.             arg_free(arg1);    /* recursive */
  858.             arg[1].arg_ptr.arg_arg = Nullarg;
  859.             free_arg(arg);    /* non-recursive */
  860.             return arg2;    /* split has builtin assign */
  861.             }
  862.         }
  863.         else if (nothing_in_common(arg1,arg2))
  864.             arg->arg_flags &= ~AF_COMMON;
  865.         if (arg->arg_type == O_ASSIGN) {
  866.             arg[1].arg_flags |= AF_ARYOK;
  867.             arg[2].arg_flags |= AF_ARYOK;
  868.         }
  869.         }
  870.         else if (arg->arg_type == O_ASSIGN)
  871.         arg[1].arg_flags |= AF_ARYOK;
  872.     }
  873.     else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
  874.         if (arg->arg_type == O_DEFINED)
  875.         arg1->arg_type = O_HELEM;    /* avoid creating one */
  876.         else
  877.         arg1->arg_type = O_LHELEM;
  878.     else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
  879.         arg1->arg_type = O_LHASH;
  880.         if (arg->arg_len > 1) {
  881.         dehoist(arg,2);
  882.         arg2 = arg[2].arg_ptr.arg_arg;
  883.         if (nothing_in_common(arg1,arg2))
  884.             arg->arg_flags &= ~AF_COMMON;
  885.         if (arg->arg_type == O_ASSIGN) {
  886.             arg[1].arg_flags |= AF_ARYOK;
  887.             arg[2].arg_flags |= AF_ARYOK;
  888.         }
  889.         }
  890.         else if (arg->arg_type == O_ASSIGN)
  891.         arg[1].arg_flags |= AF_ARYOK;
  892.     }
  893.     else if (arg1->arg_type == O_ASLICE) {
  894.         arg1->arg_type = O_LASLICE;
  895.         if (arg->arg_type == O_ASSIGN) {
  896.         dehoist(arg,2);
  897.         arg[1].arg_flags |= AF_ARYOK;
  898.         arg[2].arg_flags |= AF_ARYOK;
  899.         }
  900.     }
  901.     else if (arg1->arg_type == O_HSLICE) {
  902.         arg1->arg_type = O_LHSLICE;
  903.         if (arg->arg_type == O_ASSIGN) {
  904.         dehoist(arg,2);
  905.         arg[1].arg_flags |= AF_ARYOK;
  906.         arg[2].arg_flags |= AF_ARYOK;
  907.         }
  908.     }
  909.     else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) &&
  910.       (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) {
  911.         arg[1].arg_type |= A_DONT;
  912.     }
  913.     else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) {
  914.         (void)l(arg1);
  915.         Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
  916.             /* grow string struct to hold an lstring struct */
  917.     }
  918.     else if (arg1->arg_type == O_ASSIGN)
  919.         /*SUPPRESS 530*/
  920.         ;
  921.     else {
  922.         (void)sprintf(tokenbuf,
  923.           "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
  924.         yyerror(tokenbuf);
  925.         return arg;
  926.     }
  927.     arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
  928.     if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
  929.         arg[1].arg_flags |= AF_ARYOK;
  930.         if (arg->arg_len > 1)
  931.         arg[2].arg_flags |= AF_ARYOK;
  932.     }
  933. #ifdef DEBUGGING
  934. #ifdef macintosh
  935.     if (debug & 16)
  936.         fprintf(perldbg,"lval LEXPR\n");
  937. #else
  938.     if (debug & 16)
  939.         fprintf(stderr,"lval LEXPR\n");
  940. #endif
  941. #endif
  942.     return arg;
  943.     }
  944.     if (i == A_STAR || i == A_LSTAR) {
  945.     arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT);
  946.     return arg;
  947.     }
  948.  
  949.     /* not an array reference, should be a register name */
  950.  
  951.     if (i != A_STAB && i != A_LVAL) {
  952.     (void)sprintf(tokenbuf,
  953.       "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
  954.     yyerror(tokenbuf);
  955.     return arg;
  956.     }
  957.     arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
  958. #ifdef DEBUGGING
  959. #ifdef macintosh
  960.     if (debug & 16)
  961.     fprintf(perldbg,"lval LVAL\n");
  962. #else
  963.     if (debug & 16)
  964.     fprintf(stderr,"lval LVAL\n");
  965. #endif
  966. #endif
  967.     return arg;
  968. }
  969.  
  970. ARG *
  971. fixl(type,arg)
  972. int type;
  973. ARG *arg;
  974. {
  975.     if (type == O_DEFINED || type == O_UNDEF) {
  976.     if (arg->arg_type != O_ITEM)
  977.         arg = hide_ary(arg);
  978.     if (arg->arg_type == O_ITEM) {
  979.         type = arg[1].arg_type & A_MASK;
  980.         if (type == A_EXPR || type == A_LEXPR)
  981.         arg[1].arg_type = A_LEXPR|A_DONT;
  982.     }
  983.     }
  984.     return arg;
  985. }
  986.  
  987. void
  988. dehoist(arg,i)
  989. ARG *arg;
  990. {
  991.     ARG *tmparg;
  992.  
  993.     if (arg[i].arg_type != A_EXPR) {    /* dehoist */
  994.     tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg);
  995.     tmparg[1] = arg[i];
  996.     arg[i].arg_ptr.arg_arg = tmparg;
  997.     arg[i].arg_type = A_EXPR;
  998.     }
  999. }
  1000.  
  1001. ARG *
  1002. addflags(i,flags,arg)
  1003. register ARG *arg;
  1004. {
  1005.     arg[i].arg_flags |= flags;
  1006.     return arg;
  1007. }
  1008.  
  1009. ARG *
  1010. hide_ary(arg)
  1011. ARG *arg;
  1012. {
  1013.     if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH)
  1014.     return make_op(O_ITEM,1,arg,Nullarg,Nullarg);
  1015.     return arg;
  1016. }
  1017.  
  1018. /* maybe do a join on multiple array dimensions */
  1019.  
  1020. ARG *
  1021. jmaybe(arg)
  1022. register ARG *arg;
  1023. {
  1024.     if (arg && arg->arg_type == O_COMMA) {
  1025.     arg = listish(arg);
  1026.     arg = make_op(O_JOIN, 2,
  1027.         stab2arg(A_STAB,stabent(";",TRUE)),
  1028.         make_list(arg),
  1029.         Nullarg);
  1030.     }
  1031.     return arg;
  1032. }
  1033.  
  1034. ARG *
  1035. make_list(arg)
  1036. register ARG *arg;
  1037. {
  1038.     register int i;
  1039.     register ARG *node;
  1040.     register ARG *nxtnode;
  1041.     register int j;
  1042.     STR *tmpstr;
  1043.  
  1044.     if (!arg) {
  1045.     arg = op_new(0);
  1046.     arg->arg_type = O_LIST;
  1047.     }
  1048.     if (arg->arg_type != O_COMMA) {
  1049.     if (arg->arg_type != O_ARRAY)
  1050.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  1051.         arg->arg_flags |= AF_LISTISH;    /* see listish() below */
  1052.     return arg;
  1053.     }
  1054.     for (i = 2, node = arg; ; i++) {
  1055.     if (node->arg_len < 2)
  1056.         break;
  1057.         if (node[1].arg_type != A_EXPR)
  1058.         break;
  1059.     node = node[1].arg_ptr.arg_arg;
  1060.     if (node->arg_type != O_COMMA)
  1061.         break;
  1062.     }
  1063.     if (i > 2) {
  1064.     node = arg;
  1065.     arg = op_new(i);
  1066.     tmpstr = arg->arg_ptr.arg_str;
  1067.     StructCopy(node, arg, ARG);    /* copy everything except the STR */
  1068.     arg->arg_ptr.arg_str = tmpstr;
  1069.     for (j = i; ; ) {
  1070.         StructCopy(node+2, arg+j, ARG);
  1071.         arg[j].arg_flags |= AF_ARYOK;
  1072.         --j;        /* Bug in Xenix compiler */
  1073.         if (j < 2) {
  1074.         StructCopy(node+1, arg+1, ARG);
  1075.         free_arg(node);
  1076.         break;
  1077.         }
  1078.         nxtnode = node[1].arg_ptr.arg_arg;
  1079.         free_arg(node);
  1080.         node = nxtnode;
  1081.     }
  1082.     }
  1083.     arg[1].arg_flags |= AF_ARYOK;
  1084.     arg[2].arg_flags |= AF_ARYOK;
  1085.     arg->arg_type = O_LIST;
  1086.     arg->arg_len = i;
  1087.     str_free(arg->arg_ptr.arg_str);
  1088.     arg->arg_ptr.arg_str = Nullstr;
  1089.     return arg;
  1090. }
  1091.  
  1092. /* turn a single item into a list */
  1093.  
  1094. ARG *
  1095. listish(arg)
  1096. ARG *arg;
  1097. {
  1098.     if (arg && arg->arg_flags & AF_LISTISH)
  1099.     arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
  1100.     return arg;
  1101. }
  1102.  
  1103. ARG *
  1104. maybelistish(optype, arg)
  1105. int optype;
  1106. ARG *arg;
  1107. {
  1108.     ARG *tmparg = arg;
  1109.  
  1110.     if (optype == O_RETURN && arg->arg_type == O_ITEM &&
  1111.       arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
  1112.       ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
  1113.     tmparg = listish(tmparg);
  1114.     free_arg(arg);
  1115.     arg = tmparg;
  1116.     }
  1117.     else if (optype == O_PRTF ||
  1118.       (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
  1119.        arg->arg_type == O_F_OR_R) )
  1120.     arg = listish(arg);
  1121.     return arg;
  1122. }
  1123.  
  1124. /* mark list of local variables */
  1125.  
  1126. ARG *
  1127. localize(arg)
  1128. ARG *arg;
  1129. {
  1130.     arg->arg_flags |= AF_LOCAL;
  1131.     return arg;
  1132. }
  1133.  
  1134. ARG *
  1135. rcatmaybe(arg)
  1136. ARG *arg;
  1137. {
  1138.     ARG *arg2;
  1139.  
  1140.     if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) {
  1141.     arg2 = arg[2].arg_ptr.arg_arg;
  1142.     if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
  1143.         arg->arg_type = O_RCAT;    
  1144.         arg[2].arg_type = arg2[1].arg_type;
  1145.         arg[2].arg_ptr = arg2[1].arg_ptr;
  1146.         free_arg(arg2);
  1147.     }
  1148.     }
  1149.     return arg;
  1150. }
  1151.  
  1152. ARG *
  1153. stab2arg(atype,stab)
  1154. int atype;
  1155. register STAB *stab;
  1156. {
  1157.     register ARG *arg;
  1158.  
  1159.     arg = op_new(1);
  1160.     arg->arg_type = O_ITEM;
  1161.     arg[1].arg_type = atype;
  1162.     arg[1].arg_ptr.arg_stab = stab;
  1163.     return arg;
  1164. }
  1165.  
  1166. ARG *
  1167. cval_to_arg(cval)
  1168. register char *cval;
  1169. {
  1170.     register ARG *arg;
  1171.  
  1172.     arg = op_new(1);
  1173.     arg->arg_type = O_ITEM;
  1174.     arg[1].arg_type = A_SINGLE;
  1175.     arg[1].arg_ptr.arg_str = str_make(cval,0);
  1176.     Safefree(cval);
  1177.     return arg;
  1178. }
  1179.  
  1180. ARG *
  1181. op_new(numargs)
  1182. int numargs;
  1183. {
  1184.     register ARG *arg;
  1185.  
  1186.     Newz(203,arg, numargs + 1, ARG);
  1187.     arg->arg_ptr.arg_str = Str_new(21,0);
  1188.     arg->arg_len = numargs;
  1189.     return arg;
  1190. }
  1191.  
  1192. void
  1193. free_arg(arg)
  1194. ARG *arg;
  1195. {
  1196.     str_free(arg->arg_ptr.arg_str);
  1197.     Safefree(arg);
  1198. }
  1199.  
  1200. ARG *
  1201. make_match(type,expr,spat)
  1202. int type;
  1203. ARG *expr;
  1204. SPAT *spat;
  1205. {
  1206.     register ARG *arg;
  1207.  
  1208.     arg = make_op(type,2,expr,Nullarg,Nullarg);
  1209.  
  1210.     arg[2].arg_type = A_SPAT|A_DONT;
  1211.     arg[2].arg_ptr.arg_spat = spat;
  1212. #ifdef DEBUGGING
  1213. #ifdef macintosh
  1214.     if (debug & 16)
  1215.     fprintf(perldbg,"make_match SPAT=%lx\n",(long)spat);
  1216. #else
  1217.     if (debug & 16)
  1218.     fprintf(stderr,"make_match SPAT=%lx\n",(long)spat);
  1219. #endif
  1220. #endif
  1221.  
  1222.     if (type == O_SUBST || type == O_NSUBST) {
  1223.     if (arg[1].arg_type != A_STAB) {
  1224.         yyerror("Illegal lvalue");
  1225.     }
  1226.     arg[1].arg_type = A_LVAL;
  1227.     }
  1228.     return arg;
  1229. }
  1230.  
  1231. ARG *
  1232. cmd_to_arg(cmd)
  1233. CMD *cmd;
  1234. {
  1235.     register ARG *arg;
  1236.  
  1237.     arg = op_new(1);
  1238.     arg->arg_type = O_ITEM;
  1239.     arg[1].arg_type = A_CMD;
  1240.     arg[1].arg_ptr.arg_cmd = cmd;
  1241.     return arg;
  1242. }
  1243.  
  1244. /* Check two expressions to see if there is any identifier in common */
  1245.  
  1246. #ifdef macintosh
  1247. static int thisexpr = 0;    /* I don't care if this wraps */
  1248. #endif
  1249.  
  1250. static int
  1251. nothing_in_common(arg1,arg2)
  1252. ARG *arg1;
  1253. ARG *arg2;
  1254. {
  1255. #ifndef macintosh
  1256.     static int thisexpr = 0;    /* I don't care if this wraps */
  1257. #endif
  1258.     thisexpr++;
  1259.     if (arg_common(arg1,thisexpr,1))
  1260.     return 0;    /* hit eval or do {} */
  1261.     stab_lastexpr(defstab) = thisexpr;        /* pretend to hit @_ */
  1262.     if (arg_common(arg2,thisexpr,0))
  1263.     return 0;    /* hit identifier again */
  1264.     return 1;
  1265. }
  1266.  
  1267. /* Recursively descend an expression and mark any identifier or check
  1268.  * it to see if it was marked already.
  1269.  */
  1270.  
  1271. static int
  1272. arg_common(arg,exprnum,marking)
  1273. register ARG *arg;
  1274. int exprnum;
  1275. int marking;
  1276. {
  1277.     register int i;
  1278.  
  1279.     if (!arg)
  1280.     return 0;
  1281.     for (i = arg->arg_len; i >= 1; i--) {
  1282.     switch (arg[i].arg_type & A_MASK) {
  1283.     case A_NULL:
  1284.         break;
  1285.     case A_LEXPR:
  1286.     case A_EXPR:
  1287.         if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking))
  1288.         return 1;
  1289.         break;
  1290.     case A_CMD:
  1291.         return 1;        /* assume hanky panky */
  1292.     case A_STAR:
  1293.     case A_LSTAR:
  1294.     case A_STAB:
  1295.     case A_LVAL:
  1296.     case A_ARYLEN:
  1297.     case A_LARYLEN:
  1298.         if (marking)
  1299.         stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum;
  1300.         else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum)
  1301.         return 1;
  1302.         break;
  1303.     case A_DOUBLE:
  1304.     case A_BACKTICK:
  1305.         {
  1306.         register char *s = arg[i].arg_ptr.arg_str->str_ptr;
  1307.         register char *send = s + arg[i].arg_ptr.arg_str->str_cur;
  1308.         register STAB *stab;
  1309.  
  1310.         while (*s) {
  1311.             if (*s == '$' && s[1]) {
  1312.             s = scanident(s,send,tokenbuf);
  1313.             stab = stabent(tokenbuf,TRUE);
  1314.             if (marking)
  1315.                 stab_lastexpr(stab) = exprnum;
  1316.             else if (stab_lastexpr(stab) == exprnum)
  1317.                 return 1;
  1318.             continue;
  1319.             }
  1320.             else if (*s == '\\' && s[1])
  1321.             s++;
  1322.             s++;
  1323.         }
  1324.         }
  1325.         break;
  1326.     case A_SPAT:
  1327.         if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking))
  1328.         return 1;
  1329.         break;
  1330.     case A_READ:
  1331.     case A_INDREAD:
  1332.     case A_GLOB:
  1333.     case A_WORD:
  1334.     case A_SINGLE:
  1335.         break;
  1336.     }
  1337.     }
  1338.     switch (arg->arg_type) {
  1339.     case O_ARRAY:
  1340.     case O_LARRAY:
  1341.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1342.         (void)aadd(arg[1].arg_ptr.arg_stab);
  1343.     break;
  1344.     case O_HASH:
  1345.     case O_LHASH:
  1346.     if ((arg[1].arg_type & A_MASK) == A_STAB)
  1347.         (void)hadd(arg[1].arg_ptr.arg_stab);
  1348.     break;
  1349.     case O_EVAL:
  1350.     case O_SUBR:
  1351.     case O_DBSUBR:
  1352.     return 1;
  1353.     }
  1354.     return 0;
  1355. }
  1356.  
  1357. static int
  1358. spat_common(spat,exprnum,marking)
  1359. register SPAT *spat;
  1360. int exprnum;
  1361. int marking;
  1362. {
  1363.     if (spat->spat_runtime)
  1364.     if (arg_common(spat->spat_runtime,exprnum,marking))
  1365.         return 1;
  1366.     if (spat->spat_repl) {
  1367.     if (arg_common(spat->spat_repl,exprnum,marking))
  1368.         return 1;
  1369.     }
  1370.     return 0;
  1371. }
  1372.  
  1373. #ifdef macintosh
  1374. void reinit_consarg()
  1375. {
  1376.     str = Nullstr;
  1377.     thisexpr = 0;
  1378. }
  1379. #endif